home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 9 / The PC-SIG Library on CD ROM - Ninth Edition.iso / 301_400 / DISK0353 / DISK0353.ZIP / SHOWMOVI.PAS < prev    next >
Pascal/Delphi Source File  |  1984-09-14  |  6KB  |  233 lines
  1. program ShowAMovie;
  2. type
  3.   ParamString = string[10];
  4.   ScreenLoc = record
  5.                 character : char;
  6.                 attribute : byte;
  7.               end;
  8.   DefinedLoc  = record
  9.                 data : ScreenLoc;
  10.                 c,r  : byte;
  11.               end;
  12.   OneLine   = array[1..80] of ScreenLoc;
  13.   Screen    = array[1..25] of OneLine;
  14.   ScreenSet = ^node;
  15.   node      = record
  16.                 AScreen : Screen;
  17.                 next    : ScreenSet;
  18.               end;
  19.   DiffFil  = file of DefinedLoc;
  20. var
  21.   parameter_len            : byte absolute CSeg:$0080;
  22.   parameterLine            : string[40] absolute CSeg:$0080;
  23.   parameters               : array[1..4] of ParamString;
  24.   ScreenItself             : Screen absolute $B000:$0000;
  25.   ColorScreen              : Screen absolute $B800:$0000;
  26.   LastScreen               : Screen;
  27.   Screens, Pointer         : ScreenSet;
  28.   ScreenNum, times,
  29.   col, row, N, P           : byte;
  30.   DiffFile                 : DiffFil;
  31.   filename                 : string[14];
  32.   exists, OKAY, color      : boolean;
  33.   EndLoc                   : DefinedLoc;
  34.   ScreenSeg                : integer;
  35.  
  36. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  37. procedure GetParameters;
  38. begin
  39.   Parameters[1] := 'nofile';
  40.   Parameters[2] := 'r';
  41.   Parameters[3] := '50';
  42.   Parameters[4] := '5';
  43.   for N := 1 to 4 do
  44.     begin
  45.       P := pos('/',parameterLine);
  46.       if P <> 0 then
  47.         begin
  48.           parameters[N] := copy(parameterLine,1,P-1);
  49.           if parameters[N][1] = ' ' then delete(Parameters[N],1,1);
  50.           delete(parameterLine,1,P);
  51.         end;
  52.     end;
  53. end;
  54. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  55. function number(P : ParamString):integer;
  56. var
  57.   code, temp : integer;
  58. begin
  59.   val(P, temp, code);
  60.   if code = 0 then number := temp
  61.   else
  62.     begin
  63.       number := 0;
  64.       OKAY   := false;
  65.     end;
  66. end;
  67. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  68. procedure AttemptReset(var ThisFile : DiffFil);
  69. begin
  70.   {$I-}
  71.   reset(ThisFile);
  72.   {$I+}
  73. end;
  74. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  75. function different(var C,D:screenLoc):boolean;
  76. begin
  77.   different := (C.character <> D.character) or
  78.                (C.attribute <> D.attribute);
  79. end;
  80. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  81. procedure AddScreen(ScreenToAdd:Screen);
  82. var
  83.   temp : ScreenSet;
  84. begin
  85.   new(temp);
  86.   temp^.AScreen := ScreenToAdd;
  87.   temp^.next    := Screens;
  88.   Screens       := temp;
  89.   ScreenNum     := ScreenNum + 1;
  90. end;
  91. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  92. procedure ReadScreenFile;
  93. var
  94.   diff : DefinedLoc;
  95. begin
  96.   OKAY := true;
  97.     for row := 1 to 25 do
  98.       for col := 1 to 80 do
  99.         with LastScreen[row][col] do
  100.           begin
  101.             character := ' ';
  102.             attribute := 15;
  103.           end;
  104.     ClrScr;
  105.     filename := Parameters[1] + '.scn';
  106.     Assign(DiffFile,filename);
  107.     WriteLn;
  108.     AttemptReset(DiffFile);
  109.     if FileSize(DiffFile) > 0 then
  110.       begin
  111.         ScreenNum := 0;
  112.         GotoXY(20,10);
  113.         TextColor(white + blink);
  114.         Write('LOADING MOVIE  . . .');
  115.         TextColor(white);
  116.         While not EOF(DiffFile) do
  117.           begin
  118.             read(DiffFile,diff);
  119.               if different(diff.data,EndLoc.data) then
  120.                   LastScreen[diff.r][diff.c] := diff.data
  121.               else
  122.                   AddScreen(LastScreen);
  123.           end;  {while}
  124.       end   {if}
  125.     else
  126.       begin
  127.         gotoXY(20,10);
  128.         WriteLn('Not found');
  129.         OKAY := false;
  130.       end;
  131.     close(DiffFile);
  132. end;
  133. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  134. procedure DoPlay(list:ScreenSet;wait:integer);
  135. begin
  136.   if list <> nil then
  137.     begin
  138.       DoPlay(list^.next,wait);
  139.       ScreenItself := list^.AScreen;
  140.       ColorScreen  := list^.AScreen;
  141.       delay(wait);
  142.     end;
  143. end;
  144. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  145. procedure PlayScreens;
  146. var
  147.   wait : integer;
  148. begin
  149.   wait := number(Parameters[3]);
  150.   if OKAY then
  151.     begin
  152.       Pointer := Screens;
  153.       DoPlay(Pointer,wait);
  154.     end
  155.   else
  156.     begin
  157.       GotoXY(20,10);
  158.       Write('Invalid parameter #3');
  159.     end;
  160. end;
  161. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  162. procedure CycleScreens;
  163. var
  164.   wait : integer;
  165. begin
  166.   wait := number(Parameters[3]);
  167.   if OKAY then
  168.     repeat
  169.       Pointer := Screens;
  170.       DoPlay(Pointer,wait);
  171.     until keypressed
  172.   else
  173.     begin
  174.       GotoXY(20,10);
  175.       Write('Invalid parameter #3');
  176.     end;
  177. end;
  178. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  179. procedure initialize;
  180. begin
  181.   if (Mem[0000:1040] and 48) <> 48 then
  182.     begin
  183.       ScreenSeg := $B800;
  184.       color     := true;
  185.     end
  186.   else
  187.     begin
  188.       ScreenSeg := $B000;
  189.       color     := false;
  190.     end;
  191.   ScreenNum := 0;
  192.   Screens := nil;
  193.   with EndLoc do
  194.     begin
  195.       data.character := chr(0);
  196.       data.attribute := 0;
  197.       r := 0; c := 0;
  198.     end;
  199. end;
  200. {≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡}
  201. begin
  202.   initialize;
  203.   GetParameters;
  204.   ReadScreenFile;
  205.   GotoXY(1,1);
  206.   if OKAY then
  207.     begin
  208.       case UpCase(Parameters[2][1]) of
  209.         'C': CycleScreens;
  210.         'O': begin
  211.                PlayScreens;
  212.                repeat until keypressed;
  213.              end;
  214.         'R': begin
  215.                times := number(parameters[4]);
  216.                if OKAY then
  217.                  begin
  218.                    for N := 1 to times do PlayScreens;
  219.                    repeat until keypressed;
  220.                  end
  221.                else
  222.                  begin
  223.                    GotoXY(20,10);
  224.                    Write('Invalid parameter #4');
  225.                  end;
  226.              end;
  227.       else
  228.         GotoXY(20,10);
  229.         Write('Invalid parameter #2');
  230.       end; {case}
  231.   end;  {if OKAY}
  232.   ClrScr;
  233. end.